home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 25 / Cream of the Crop 25.iso / image / eimg202a.zip / DEMO / UNIT1.PAS < prev   
Pascal/Delphi Source File  |  1997-01-25  |  6KB  |  230 lines
  1. unit Unit1;
  2.  
  3. interface
  4.  
  5. uses
  6.      Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.      {$IFNDEF VER80 }
  8.      Windows, ComCtrls,
  9.      {$ELSE }
  10.      wintypes, winprocs,
  11.      {$ENDIF }
  12.      StdCtrls, Buttons, EnhImage, ExtCtrls, Menus;
  13.  
  14. type
  15.   TForm1 = class(TForm)
  16.     img: TEnhImage;
  17.     original: TEnhImage;
  18.     Label1: TLabel;
  19.     Label2: TLabel;
  20.     Label3: TLabel;
  21.     SatLab: TLabel;
  22.     LigLab: TLabel;
  23.     ConLab: TLabel;
  24.     Label7: TLabel;
  25.     Label8: TLabel;
  26.     Label9: TLabel;
  27.     temp: TEnhImage;
  28.     Label4: TLabel;
  29.     Label5: TLabel;
  30.     BitBtn1: TBitBtn;
  31.     Panel1: TPanel;
  32.     PaintBox1: TPaintBox;
  33.     Panel2: TPanel;
  34.     PaintBox2: TPaintBox;
  35.     Label6: TLabel;
  36.     MainMenu1: TMainMenu;
  37.     Loadpicture1: TMenuItem;
  38.     Loadpicture2: TMenuItem;
  39.     N1: TMenuItem;
  40.     Exit1: TMenuItem;
  41.     OpenDlg: TOpenDialog;
  42.     saturation: TScrollBar;
  43.     lightness: TScrollBar;
  44.     contrast: TScrollBar;
  45.     Effects: TMenuItem;
  46.     FlipHorizontal1: TMenuItem;
  47.     Flipvertical1: TMenuItem;
  48.     Togray2: TMenuItem;
  49.     Invert1: TMenuItem;
  50.     procedure saturationChange(Sender: TObject);
  51.     procedure LightnessChange(Sender: TObject);
  52.     procedure ContrastChange(Sender: TObject);
  53.     procedure FormCreate(Sender: TObject);
  54.     procedure PaintBox1Paint(Sender: TObject);
  55.     procedure PaintBox2Paint(Sender: TObject);
  56.     procedure BitBtn1Click(Sender: TObject);
  57.     procedure Loadpicture2Click(Sender: TObject);
  58.     procedure invertClick(Sender: TObject);
  59.     procedure FlipHorizontalClick(Sender: TObject);
  60.     procedure FlipVerticalClick(Sender: TObject);
  61.     procedure ToGrayClick(Sender: TObject);
  62.   private
  63.     { Private declarations }
  64.     LastChange:integer;
  65.     LastSat   :integer;
  66.     LastCon   :integer;
  67.     LastLig   :integer;
  68.     procedure UpdateFrequencies;
  69.   public
  70.     { Public declarations }
  71.     procedure AssignOriginal(ABitmap:graphics.TBitmap);
  72.   end;
  73.  
  74. var
  75.   Form1: TForm1;
  76.  
  77. implementation
  78.  
  79. {$R *.DFM}
  80.  
  81. procedure TForm1.UpdateFrequencies;
  82. begin
  83. img.DrawFrequency(1,true,PaintBox1.canvas,0,0,PaintBox1.width,PaintBox1.height);
  84. img.DrawFrequency(2,true,PaintBox2.canvas,0,0,PaintBox2.width,PaintBox2.height);
  85. end;  { TForm1.UpdateFrequencies }
  86.  
  87. procedure TForm1.saturationChange(Sender: TObject);
  88. begin
  89. if (LastSat=saturation.position) and
  90.    (LastCon=contrast  .position) and
  91.    (LastLig=lightness .position) then
  92.   exit;
  93. LastSat:=saturation.position;
  94. LastCon:=contrast  .position;
  95. LastLig:=lightness .position;
  96. if LastChange<>1 then
  97.   begin
  98.   LastChange:=1;
  99.   end;
  100. SatLab.caption:=IntToStr(saturation.position);
  101. img.picture.bitmap.assign(original.picture.bitmap);
  102. img.VariateColors(saturation.position,contrast.position,lightness.position);
  103. UpdateFrequencies;
  104. end;
  105.  
  106. procedure TForm1.LightnessChange(Sender: TObject);
  107. begin
  108. if (LastSat=saturation.position) and
  109.    (LastCon=contrast  .position) and
  110.    (LastLig=lightness .position) then
  111.   exit;
  112. LastSat:=saturation.position;
  113. LastCon:=contrast  .position;
  114. LastLig:=lightness .position;
  115. if LastChange<>2 then
  116.   begin
  117.   LastChange:=2;
  118.   temp.picture.bitmap.assign(original.picture.bitmap);
  119.   temp.VariateColors(saturation.position,contrast.position,0);
  120.   end;
  121. LigLab.caption:=IntToStr(lightness.position);
  122. img.picture.bitmap.assign(temp.picture.bitmap);
  123. img.lightness(lightness.position);
  124. UpdateFrequencies;
  125. end;
  126.  
  127. procedure TForm1.ContrastChange(Sender: TObject);
  128. begin
  129. if (LastSat=saturation.position) and
  130.    (LastCon=contrast  .position) and
  131.    (LastLig=lightness .position) then
  132.   exit;
  133. LastSat:=saturation.position;
  134. LastCon:=contrast  .position;
  135. LastLig:=lightness .position;
  136. if LastChange<>3 then
  137.   begin
  138.   LastChange:=3;
  139.   temp.picture.bitmap.assign(original.picture.bitmap);
  140.   temp.saturate(saturation.position);
  141.   end;
  142. ConLab.caption:=IntToStr(contrast.position);
  143. img.picture.bitmap.assign(temp.picture.bitmap);
  144. img.VariateColors(0,contrast.position,lightness.position);
  145. UpdateFrequencies;
  146. end;
  147.  
  148. procedure TForm1.AssignOriginal(ABitmap:graphics.TBitmap);
  149. var RatioW:real;
  150.     RatioH:real;
  151.     ratio :real;
  152. begin
  153. LastChange:=0;
  154. LastSat   :=-1000;
  155. LastCon   :=-1000;
  156. LastLig   :=-1000;
  157. RatioW:=original.width /ABitmap.width ;
  158. RatioH:=original.height/ABitmap.height;
  159. if RatioW>RatioH then
  160.   ratio:=RatioH
  161. else
  162.   ratio:=RatioW;
  163. if (ratio>1) then ratio:=1;
  164. ratio:=ratio*1;
  165. original.picture.bitmap.width :=trunc(ABitmap.width *ratio);
  166. original.picture.bitmap.height:=trunc(ABitmap.height*ratio);
  167. original.picture.bitmap.canvas.StretchDraw(rect(0,0,original.picture.width,original.picture.height),ABitmap);
  168. img.picture.bitmap.assign(original.picture.bitmap);
  169. UpdateFrequencies;
  170. end;  { TForm1.AssignOriginal }
  171.  
  172. procedure TForm1.FormCreate(Sender: TObject);
  173. begin
  174. LastChange:=0;
  175. LastSat   :=-1000;
  176. LastCon   :=-1000;
  177. LastLig   :=-1000;
  178. AssignOriginal(temp.picture.bitmap);
  179. end;
  180.  
  181. procedure TForm1.PaintBox1Paint(Sender: TObject);
  182. begin
  183. img.DrawFrequency(1,true,PaintBox1.canvas,0,0,PaintBox1.width,PaintBox1.height);
  184. end;
  185.  
  186. procedure TForm1.PaintBox2Paint(Sender: TObject);
  187. begin
  188. img.DrawFrequency(2,true,PaintBox2.canvas,0,0,PaintBox2.width,PaintBox2.height);
  189. end;
  190.  
  191. procedure TForm1.BitBtn1Click(Sender: TObject);
  192. begin
  193. close;
  194. end;
  195.  
  196. procedure TForm1.Loadpicture2Click(Sender: TObject);
  197. begin
  198. if OpenDlg.execute then
  199.   begin
  200.   try
  201.     temp.LoadPicture(OpenDlg.FileName);
  202.     AssignOriginal(temp.picture.bitmap);
  203.   except
  204.     MessageDlg('Error reading '+OpenDlg.FileName,mtWarning,[mbOk],0);
  205.     end;  { try }
  206.   end;  { if }
  207. end;
  208.  
  209. procedure TForm1.invertClick(Sender: TObject);
  210. begin
  211. img.invert;
  212. end;
  213.  
  214. procedure TForm1.FlipHorizontalClick(Sender: TObject);
  215. begin
  216. img.FlipHorizontal;
  217. end;
  218.  
  219. procedure TForm1.FlipVerticalClick(Sender: TObject);
  220. begin
  221. img.FlipVertical;
  222. end;
  223.  
  224. procedure TForm1.ToGrayClick(Sender: TObject);
  225. begin
  226. img.ToGray;
  227. end;
  228.  
  229. end.
  230.